PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/txt132.exe/LEVEL2.PAS

Pascal/Delphi Source File | 1993-01-23 | 5KB | 206 lines

{$X+,V-}
program Level2;

uses Objects, Drivers, Views, Menus, App, MsgBox;

Const
  cmTry = 150;
  cmExec = 151;
  cmOther = 152;
  cm25 = 153;
  cm50 = 154;

type
  PDisplayWindow = ^DisplayWindow;
  DisplayWindow = object(Twindow)
    constructor Init;
    end;

  PDispInterior = ^DispInterior;
  DispInterior = object(TView)
    procedure Draw; virtual;
    end;

  TMyApp = object(TApplication)
    constructor Init;
    procedure Idle; virtual;
    procedure DosShell;
    procedure InitMenuBar; virtual;
    procedure InitStatusLine; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    end;

var
  DispInt : PDispInterior;
  MyApp: TMyApp;

FUNCTION Hex2(B : Byte) : String;
Const
  HexArray : array[0..15] of char = '0123456789ABCDEF';
begin
Hex2[0] := #2;
Hex2[1] := HexArray[B shr 4];
Hex2[2] := HexArray[B and $F];
end;

FUNCTION Hex4(W : Word) : String;
begin Hex4 := Hex2(Hi(W))+Hex2(Lo(W)); end;

constructor DisplayWindow.Init;
var
  R : TRect;
begin
R.Assign(25,6,54,15);
TWindow.Init(R, 'Info', 0);
Flags := wfMove;
GrowMode := 0;
GetExtent(R);
R.Grow(-1,-1);
DispInt := New(PDispInterior, Init(R));
Insert(DispInt);
end;

PROCEDURE DispInterior.Draw;
var S : String[20];
begin
TView.Draw;
Str(ScreenMode, S);
WriteStr(0,1, '  Mode is '+S+'($'+Hex4(ScreenMode)+')', $02);
Str(StartUpMode, S);
WriteStr(0,2, '  StartUpMode is '+S+'($'+Hex4(StartUpMode)+')', $02);
Str(ScreenWidth, S);
WriteStr(0,3, '  Width = '+S, $02);
Str(ScreenHeight, S);
WriteStr(0,4, '  Height = '+S, $02);
if SimulatedMouse then S := 'Simulated' else S := 'Driver';
WriteStr(0,5, '  Mouse is '+S, $02);
end;

constructor TMyApp.Init;
begin
TApplication.Init;
if not (Lo(ScreenMode) in [0..3,7]) then
  begin
  StartupMode := Lo(ScreenMode);
  SimMouse;
  end
else StartupMode := ScreenMode;
DeskTop^.Insert(New(PDisplayWindow, Init));
end;

procedure TMyApp.DosShell;
begin
  if not (Lo(ScreenMode) in [0..3,7]) then
    DriverMouse;
  TApplication.DosShell;
  if not (Lo(ScreenMode) in [0..3,7]) then
    begin
    ScreenMode := Lo(ScreenMode);  {strip off smFont8x8 bit}
    SimMouse;
    HideMouse;
    ReDraw;
    ShowMouse;
    end;
  DispInt^.DrawView;
end;

procedure TMyApp.Idle;
const
  OldMouse : boolean = False;
  OldMode : word = $ffff;
begin
TApplication.Idle;
if (ScreenMode <> OldMode) or (SimulatedMouse <> OldMouse) then
  begin
  OldMouse := SimulatedMouse;
  OldMode := ScreenMode;
  DispInt^.DrawView;
  end;
end;

procedure TMyApp.InitMenuBar;
var R: TRect;
begin
GetExtent(R);
R.B.Y := R.A.Y + 1;
MenuBar := New(PMenuBar, Init(R, NewMenu(
  NewSubMenu('~F~ile', hcNoContext, NewMenu(
    NewItem('~D~os', 'AltD', kbAltD, cmExec, hcNoContext,
    NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
    nil))),
  NewSubMenu('~V~ideo', hcNoContext, NewMenu(
    NewItem('~2~5 Line display', 'alt-2', kbAlt2, cm25, hcNoContext,
    NewItem('~4~3/50 Line display', 'alt-5', kbAlt5, cm50, hcNoContext,
    NewItem('~O~ther Mode', 'alt-O', kbAltO, cmOther, hcNoContext,
    nil)))), nil)))));
end;

procedure TMyApp.InitStatusLine;
var R: TRect;
begin
  GetExtent(R);
  R.A.Y := R.B.Y - 1;
  StatusLine := New(PStatusLine, Init(R,
    NewStatusDef(0, $FFFF,
      NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
      nil),
    nil)
  ));
end;

procedure TMyApp.HandleEvent(var Event: TEvent);
var
  S : string[3];
  Mode, Code : integer;
  Cmd : word;
begin
TApplication.HandleEvent(Event);

if (Event.What = evCommand) then
  begin
  case Event.Command of
    cm25 : if ScreenMode <> 3  then
              begin
              DriverMouse;
              SetScreenMode(3);
              end;
    cm50 : if ScreenMode <> $103 then
              begin
              DriverMouse;
              SetScreenMode($103);
              end;
    cmOther :  begin
               S := '';
               repeat
                 Cmd := InputBox('Mode', 'Try which mode', S, 3);
                 if Cmd = cmOK then
                   begin
                   Val(S, Mode, Code);
                   if Code = 0 then
                     if Lo(ScreenMode) <> Mode then
                       begin
                       if Lo(Mode) in [0..3,7] then
                         DriverMouse
                       else SimMouse;
                       HideMouse;
                       SetScreenMode(Mode);
                       if not (Lo(ScreenMode) in [0..3,7]) then
                         ScreenMode := Lo(ScreenMode);  {strip off any smFont8x8 bit}
                       ShowMouse;
                       end;
                   end;
               until (Cmd = cmCancel) or (Code = 0);
               end;
    cmExec :  DosShell;
     end;
  ClearEvent(Event);
  end;
end;

begin
  MyApp.Init;
  MyApp.Run;
  MyApp.Done;
end.